{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE KindSignatures             #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Majalan.Base.Context
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Context type (aka Reader env).
-- 
--------------------------------------------------------------------------------

module Majalan.Base.Context
  ( 

    UserCtx
  , Ctx
  , MeterInfo(..)
  , ContextF
  , initialCtx

  , ContextM(..)


  , set_metered
  , set_free_metered
  , ask_meter_info

  , quarter_note_length

  , durationInSeconds
  , interpretSeconds

--  , updateUserCtx
  , getUserCtx


  )  where


import Majalan.Base.Internal.Base

import Control.Applicative

-- Potentially we might want TimeSig in Ctx, it may be useful
-- for pattern generating /sequencers/. 
--
-- Remember - cannot use Haskell'\s Rational datatype for time
-- signatures as it normalizes, e.g. 2%2 == 4%4

data Ctx uctx = Ctx 
    { ctx_meter_info    :: !MeterInfo
    , ctx_user          :: !uctx
    }



-- | Free metered is 1/4 time with quarter-note length derived 
-- from BPM.
--
data MeterInfo = MeterInfo !TimeSig !BPM
  deriving (Eq,Show)


type ContextF uctx = Ctx uctx -> Ctx uctx 

initialCtx :: uctx -> Ctx uctx 
initialCtx uctx = Ctx { ctx_meter_info  = MeterInfo (4,4) 120
                      , ctx_user        = uctx
                      }



type family UserCtx (m :: * -> *) :: *


class (Applicative m, Monad m) => ContextM (m :: * -> *) where
  askCtx        :: uctx ~ UserCtx m => m (Ctx uctx)
  asksCtx       :: uctx ~ UserCtx m => (Ctx uctx -> a) -> m a
  localize      :: uctx ~ UserCtx m => ContextF uctx -> m a -> m a

  asksCtx f     = f <$> askCtx


-- updateCtx :: ContextF uctx -> Ctx uctx -> Ctx uctx
-- updateCtx f ctx@(Ctx { ctx_user = uctx }) = ctx { ctx_user = f uctx} 

getUserCtx :: Ctx uctx -> uctx
getUserCtx (Ctx { ctx_user = uctx }) = uctx


set_metered :: TimeSig -> BPM -> ContextF uctx
set_metered ts bpm      = \s -> s { ctx_meter_info = MeterInfo ts bpm }


set_free_metered :: Seconds -> ContextF uctx
set_free_metered qnl    = \s -> 
    s { ctx_meter_info = MeterInfo (1,4) (bpmFromQnl qnl) }


ask_meter_info :: ContextM m => m MeterInfo
ask_meter_info = asksCtx ctx_meter_info 

quarter_note_length :: ContextM m => m Seconds
quarter_note_length = fn <$> asksCtx ctx_meter_info 
  where
    fn (MeterInfo _ bpm) = 60 / bpm



durationInSeconds :: ContextM m => Beat -> m Seconds 
durationInSeconds drn = fn <$> asksCtx ctx_meter_info 
  where
    fn (MeterInfo _ bpm) = beatToSeconds bpm drn


-- asksCtx $ \ctx -> beatToSeconds (ctx_bpm ctx) drn

interpretSeconds :: ContextM m => Seconds -> m Beat
interpretSeconds s = fn <$> asksCtx ctx_meter_info 
  where
    fn (MeterInfo _ bpm) = secondsToBeat bpm s


